home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / txt132.exe / LEVEL1.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-23  |  4KB  |  179 lines
  1. {$X+,V-}
  2. program Level1;
  3.  
  4. uses Objects, Drivers, Views, Menus, App, MsgBox;
  5.  
  6. Const
  7.   cmTry = 150;
  8.   cmExec = 151;
  9.   cmOther = 152;
  10.   cm25 = 153;
  11.   cm50 = 154;
  12.  
  13. type
  14.   PDisplayWindow = ^DisplayWindow;
  15.   DisplayWindow = object(Twindow)
  16.     constructor Init;
  17.     end;
  18.  
  19.   PDispInterior = ^DispInterior;
  20.   DispInterior = object(TView)
  21.     procedure Draw; virtual;
  22.     end;
  23.  
  24.   TMyApp = object(TApplication)
  25.     constructor Init;
  26.     procedure Idle; virtual;
  27.     procedure DosShell;
  28.     procedure InitMenuBar; virtual;
  29.     procedure InitStatusLine; virtual;
  30.     procedure HandleEvent(var Event: TEvent); virtual;
  31.     end;
  32.  
  33. var
  34.   DispInt : PDispInterior;
  35.   MyApp: TMyApp;
  36.  
  37. FUNCTION Hex2(B : Byte) : String;
  38. Const
  39.   HexArray : array[0..15] of char = '0123456789ABCDEF';
  40. begin
  41. Hex2[0] := #2;
  42. Hex2[1] := HexArray[B shr 4];
  43. Hex2[2] := HexArray[B and $F];
  44. end;
  45.  
  46. FUNCTION Hex4(W : Word) : String;
  47. begin Hex4 := Hex2(Hi(W))+Hex2(Lo(W)); end;
  48.  
  49. constructor DisplayWindow.Init;
  50. var
  51.   R : TRect;
  52. begin
  53. R.Assign(25,6,54,15);
  54. TWindow.Init(R, 'Info', 0);
  55. Flags := wfMove;
  56. GrowMode := 0;
  57. GetExtent(R);
  58. R.Grow(-1,-1);
  59. DispInt := New(PDispInterior, Init(R));
  60. Insert(DispInt);
  61. end;
  62.  
  63. PROCEDURE DispInterior.Draw;
  64. var S : String[20];
  65. begin
  66. TView.Draw;
  67. Str(ScreenMode, S);
  68. WriteStr(0,1, '  Mode is '+S+'($'+Hex4(ScreenMode)+')', $02);
  69. Str(StartUpMode, S);
  70. WriteStr(0,2, '  StartUpMode is '+S+'($'+Hex4(StartUpMode)+')', $02);
  71. Str(ScreenWidth, S);
  72. WriteStr(0,3, '  Width = '+S, $02);
  73. Str(ScreenHeight, S);
  74. WriteStr(0,4, '  Height = '+S, $02);
  75. end;
  76.  
  77. constructor TMyApp.Init;
  78. begin
  79. TApplication.Init;
  80. if not (Lo(ScreenMode) in [0..3,7]) then
  81.   StartupMode := Lo(ScreenMode)
  82. else StartupMode := ScreenMode;   {may have smFont8x8 set}
  83. DeskTop^.Insert(New(PDisplayWindow, Init));
  84. end;
  85.  
  86. procedure TMyApp.DosShell;
  87. begin
  88.   TApplication.DosShell;
  89.   if not (Lo(ScreenMode) in [0..3,7]) then
  90.     ScreenMode := Lo(ScreenMode);  {strip off smFont8x8 bit}
  91. end;
  92.  
  93. procedure TMyApp.Idle;
  94. const
  95.   OldMode : word = $ffff;
  96. begin
  97. TApplication.Idle;
  98. if (ScreenMode <> OldMode) then
  99.   begin
  100.   OldMode := ScreenMode;
  101.   DispInt^.DrawView;
  102.   end;
  103. end;
  104.  
  105. procedure TMyApp.InitMenuBar;
  106. var R: TRect;
  107. begin
  108. GetExtent(R);
  109. R.B.Y := R.A.Y + 1;
  110. MenuBar := New(PMenuBar, Init(R, NewMenu(
  111.   NewSubMenu('~F~ile', hcNoContext, NewMenu(
  112.     NewItem('~D~os', 'AltD', kbAltD, cmExec, hcNoContext,
  113.     NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  114.     nil))),
  115.   NewSubMenu('~V~ideo', hcNoContext, NewMenu(
  116.     NewItem('~2~5 Line display', 'alt-2', kbAlt2, cm25, hcNoContext,
  117.     NewItem('~4~3/50 Line display', 'alt-5', kbAlt5, cm50, hcNoContext,
  118.     NewItem('~O~ther Mode', 'alt-O', kbAltO, cmOther, hcNoContext,
  119.     nil)))), nil)))));
  120. end;
  121.  
  122. procedure TMyApp.InitStatusLine;
  123. var R: TRect;
  124. begin
  125.   GetExtent(R);
  126.   R.A.Y := R.B.Y - 1;
  127.   StatusLine := New(PStatusLine, Init(R,
  128.     NewStatusDef(0, $FFFF,
  129.       NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  130.       nil),
  131.     nil)
  132.   ));
  133. end;
  134.  
  135. procedure TMyApp.HandleEvent(var Event: TEvent);
  136. var
  137.   S : string[3];
  138.   Mode, Code : integer;
  139.   Cmd : word;
  140. begin
  141. TApplication.HandleEvent(Event);
  142.  
  143. if (Event.What = evCommand) then
  144.   begin
  145.   case Event.Command of
  146.     cm25 : if ScreenMode <> 3  then
  147.               SetScreenMode(3);
  148.     cm50 : if ScreenMode <> $103 then
  149.               SetScreenMode($103);
  150.     cmOther :  begin
  151.                S := '';
  152.                repeat
  153.                  Cmd := InputBox('Mode', 'Try which mode', S, 3);
  154.                  if Cmd = cmOK then
  155.                    begin
  156.                    Val(S, Mode, Code);
  157.                    if Code = 0 then
  158.                      if Lo(ScreenMode) <> Mode then
  159.                        begin
  160.                        SetScreenMode(Mode);
  161.                        if not (Lo(ScreenMode) in [0..3,7]) then
  162.                          ScreenMode := Lo(ScreenMode);  {strip off any smFont8x8 bit}
  163.                        end;
  164.                    end;
  165.                until (Cmd = cmCancel) or (Code = 0);
  166.                end;
  167.     cmExec :  DosShell;
  168.      end;
  169.   ClearEvent(Event);
  170.   end;
  171. end;
  172.  
  173. begin
  174.   MyApp.Init;
  175.   MyApp.Run;
  176.   MyApp.Done;
  177. end.
  178.  
  179.